home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / clipper / rcmplb30.zip / RCMPDEMO.PRG < prev    next >
Text File  |  1994-02-20  |  16KB  |  462 lines
  1. *--------------------------------------------------------------------------
  2. *                         CA-CLIPPER 5.xx VERSION
  3. *--------------------------------------------------------------------------
  4. * RCmpDemo.PRG - Program to demonstrate the use of the functions
  5. *                in the CA-Clipper Library, RCmpLib v3.0
  6. *
  7. * Used functions :
  8. *
  9. *       R_CmpFile ()  - Compress one or more files into one archive
  10. *       R_DCmpFile () - Extract  one or more files from an archive
  11. *       R_CmpList ()  - Retrieves info about files in a RCmpLib archive
  12. *       R_FSize ()    - Determine the size of a file
  13. *       R_LastErr ()  - Determine last error
  14. *       R_CmpStr ()   - Compress a string
  15. *       R_DCmpStr ()  - Decompress a string
  16. *
  17. * Compile    :  CLIPPER RCMPDEMO /N
  18. *
  19. * Link       :  RTLINK   file RCMPDEMO lib RCMPLIB    - or -
  20. *               BLINKER  file RCMPDEMO lib RCMPLIB    - or -
  21. *               EXOSPACE file RCMPDEMO lib RCMPLIB EXO PAC INT10
  22. *
  23. * Syntax     :  RCMPDEMO
  24. *--------------------------------------------------------------------------
  25. * Date       :  20/02/94
  26. *--------------------------------------------------------------------------
  27. * Author     :  Rolf van Gelder
  28. *               Binnenwiertzstraat 27
  29. *               5615 HG  EINDHOVEN
  30. *               THE NETHERLANDS
  31. *
  32. * E-Mail     :  Internet   : RCROLF@urc.tue.nl
  33. *               BitNet     : RCROLF@heitue5
  34. *               CompuServe : >INTERNET:rcrolf@urc.tue.nl
  35. *--------------------------------------------------------------------------
  36. * (c) 1994  Rolf van Gelder, All rights reserved
  37. *--------------------------------------------------------------------------
  38.  
  39. *--------------------------------------------------------------------------
  40. * Standard Clipper HEADER files
  41. *--------------------------------------------------------------------------
  42. #include "Directry.CH"
  43. #include "Set.CH"
  44.  
  45. *--------------------------------------------------------------------------
  46. * RCMPLIB header file
  47. *--------------------------------------------------------------------------
  48. #include "RCmpLib.CH"
  49.  
  50. *-- Initialize the array with error messages (from RCmpLib.CH)
  51. STATIC  aErrTxt := CP_ERRMSG
  52.  
  53.  
  54. *--------------------------------------------------------------------------
  55. * STATIC CODEBLOCKS
  56. *--------------------------------------------------------------------------
  57.  
  58. *-- Display "Hit any key" message & wait for a key
  59. STATIC  bHitKey := { || DevPos (MaxRow(), 32), DevOut ( 'Hit any key ....' ),;
  60.                         InKey ( 0 ) }
  61.  
  62. *-- Display headerline (with clear screen)
  63. STATIC  bHeader := { || Scroll (), DevPos ( 0, 0 ), ;
  64.                         DevOut ('RCmpDemo: Demo program for RCmpLib v3.0 - '+;
  65.                                 '20/02/94     (c) 1994  Rolf van Gelder' ), ;
  66.                         DevPos ( 1, 0 ), ;
  67.                         DevOut ( Replicate ( '─', 80 ) ) }
  68.  
  69. *--------------------------------------------------------------------------
  70. *
  71. *                          Main function : RCmpDemo
  72. *
  73. *--------------------------------------------------------------------------
  74. FUNCTION RCmpDemo
  75.  
  76. *-- Main menu
  77. LOCAL   aMenu := { ;
  78.    'Compress files into an archive      - R_CmpFile()' , ;
  79.    'Show file-info from an archive file - R_CmpList()', ;
  80.    'Extract files from an archive       - R_DCmpFile()', ;
  81.    'String compression/decompression    - R_CmpStr(),R_DCmpStr()', ;
  82.    'End of Demo' }
  83.  
  84. LOCAL   nChoice := 1                    && Menu choice
  85. LOCAL   nRetCode                        && Return code
  86. LOCAL   cOldCol                         && Old color
  87. LOCAL   aCmpList                        && Array with file-info
  88. LOCAL   nTotOrgSize                     && Counter
  89. LOCAL   nTotCmpSize                     && Counter
  90. LOCAL   nFiles                          && Counter
  91. LOCAL   nHandle                         && File handle
  92. LOCAL   cString                         && String buffer
  93. LOCAL   nOrgSize                        && Original string size
  94. LOCAL   nCmpSize                        && Compressed string size
  95.  
  96. SetColor ( 'W+/B' )
  97.  
  98. *-- Disable scoreboard
  99. Set ( _SET_SCOREBOARD, .f. )
  100.  
  101. *--------------------------------------------------------------------------
  102. *                   M A I N   P R O G R A M   L O O P
  103. *--------------------------------------------------------------------------
  104. DO WHILE .t.
  105.  
  106.    *-- Display header lines
  107.    Eval ( bHeader )
  108.  
  109.    *-- Do some advertisement ...
  110.    DevPos ( 2,21 )
  111.    DevOut ( 'THE COMPRESSION LIBRARY FOR CA-CLIPPER' )
  112.    DevPos ( 4, 11 )
  113.    DevOut ( ' ▄▄▄▄▄▄▄  ▄▄▄▄▄▄▄                    ▄        ▄▄  ▄      ' )
  114.    DevPos ( 5, 11 )
  115.    DevOut ( '▒▒▒▒▒▒▒█ ▒▒▒▒▒▒▒▀                   ▒█       ▒▒▀ ▒█      ' )
  116.    DevPos ( 6, 11 )
  117.    DevOut ( '▒█▄▄▄▄▒█ ▒█        ▄▄▄▄▄▄▄  ▄▄▄▄▄▄▄ ▒█        ▄▄ ▒█▄▄▄▄▄▄' )
  118.    DevPos ( 7, 11 )
  119.    DevOut ( '▒▒▒▒▒▒▒▀ ▒█       ▒▒▒▒▒▒▒█ ▒▒▒▒▒▒▒█ ▒█       ▒▒█ ▒▒▒▒▒▒▒█' )
  120.    DevPos ( 8, 11 )
  121.    DevOut ( '▒█   ▒▀▄ ▒█▄▄▄▄▄▄ ▒▒█▒█▒▒█ ▒█▄▄▄▄▒█ ▒█▄▄▄▄▄▄ ▒▒█ ▒█▄▄▄▄▒█' )
  122.    DevPos ( 9, 11 )
  123.    DevOut ( '▒▀    ▒▀ ▒▒▒▒▒▒▒▀ ▒▒▀▒▀▒▒▀ ▒▒▒▒▒▒▒▀ ▒▒▒▒▒▒▒▀ ▒▒▀ ▒▒▒▒▒▒▒▀' )
  124.    DevPos ( 10, 11 )
  125.    DevOut ( '                           ▒█                            ' )
  126.    DevPos ( 11, 11 )
  127.    DevOut ( ' (c) 1994 Rolf van Gelder  ▒▀ Eindhoven, The Netherlands ' )
  128.  
  129.    *-- Draw double box for main menu
  130.    DispBox ( 13, 8, 19, 71, 2 )
  131.  
  132.    *-- Display main menu
  133.    nChoice := AChoice ( 14, 10, 18, 69, aMenu, , , nChoice )
  134.  
  135.    IF LastKey () = 27 .or. nChoice = Len ( aMenu )
  136.       *-- <Esc> or 'End of Demo'
  137.       EXIT
  138.    ENDIF
  139.  
  140.    *-- Display header lines
  141.    Eval ( bHeader )
  142.  
  143.    DO CASE
  144.    CASE nChoice = 1
  145.       *-- COMPRESS FILES INTO AN ARCHIVE
  146.  
  147.       CenterMsg ( 3, 'COMPRESS FILES INTO AN ARCHIVE - R_CmpFile()' )
  148.  
  149.       cOldCol := SetColor ( 'W+/BG' )
  150.       DispBox ( 5, 13, 8, 64 )
  151.       DevPos ( 6, 14 )
  152.       DevOut ( ' The files RCMPLIB.*, *.PRG and DUTCH.REG will be ' )
  153.       DevPos ( 7, 14 )
  154.       DevOut ( ' compressed into an archive called ARCHIVE.RCP.   ' )
  155.       SetColor ( cOldCol )
  156.  
  157.       *-- Hit any key ....
  158.       Eval ( bHitKey )
  159.  
  160.       Scroll ( 5, 0 )
  161.  
  162.       *-- Draw box for progression bar
  163.       cOldCol := SetColor ( 'W+/R' )
  164.       Scroll ( 6, 23, 8, 56 )
  165.       DispBox ( 6, 23, 8, 56 )
  166.       SetColor ( cOldCol )
  167.       DevPos ( 9,25 )
  168.       DevOut ( 'Compressing: ' )
  169.  
  170.       *--------------------------------------------------------------------
  171.       * Files to compress : RCmpLib.*, *.PRG and Dutch.REG
  172.       * Archive file      : Archive.RCP
  173.       * Keep originals    : lMove = .F.
  174.       * Progression bar   : Length = 30,           (Row,Col) = (7,25)
  175.       *                   : Character = Chr (177), Color = Yellow on Red
  176.       * Password          : none (nil)
  177.       * Interruptable     : lEscape = .T.
  178.       * CodeBlock         : Function DispName ( Fname, row, col )
  179.       *--------------------------------------------------------------------
  180.       nRetCode := R_CmpFile ( { 'RCmpLib.*', '*.PRG', 'Dutch.REG' }, ;
  181.          'Archive.RCP', .F., 30, 7, 25, Chr ( 177 ), 'GR+/R', nil, .T., ;
  182.          { |x| DispName ( x, 9, 38 ) } )
  183. *      nRetCode := R_CmpFile ( { 'RCmpLib.*', '*.PRG', 'Dutch.REG' }, ;
  184. *         'Archive.RCP', .F., 10, 7, 25, Chr ( 177 ), 'GR+/R', nil, .T., ;
  185. *         { |x| DispName ( x, 9, 38 ) } )
  186.  
  187.       *-- Clear box
  188.       Scroll ( 6, 0 )
  189.  
  190.       IF nRetCode != CP_OKAY
  191.          *-- Error detected : display error message
  192.          Alert ( 'Error compressing: ' + aErrTxt [ nRetCode ] )
  193.  
  194.       ELSE
  195.          *-- No errors detected !
  196.          Alert ( 'Archive ARCHIVE.RCP created.' )
  197.  
  198.       ENDIF
  199.  
  200.    CASE nChoice = 2
  201.       *-- SHOW FILE-INFO FROM AN ARCHIVE FILE
  202.  
  203.       CenterMsg ( 3, 'SHOW FILE-INFO FROM AN ARCHIVE FILE - R_CmpList()' )
  204.  
  205.       cOldCol := SetColor ( 'W+/BG' )
  206.       DispBox ( 5, 17, 8, 60 )
  207.       DevPos ( 6, 18 )
  208.       DevOut ( ' File information for the files in the    ' )
  209.       DevPos ( 7, 18 )
  210.       DevOut ( ' archive file ARCHIVE.RCP will be listed. ' )
  211.       SetColor ( cOldCol )
  212.  
  213.       *-- Hit any key ....
  214.       Eval ( bHitKey )
  215.  
  216.